home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pas_0593.zip / COPYSHOW.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-08  |  2KB  |  81 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 99 of 132
  3. From : Rob Perelman                        1:202/1308.0         02 May 93  13:47
  4. To   : All
  5. Subj : Copyshow
  6. ────────────────────────────────────────────────────────────────────────────────
  7. I got it to work.  I sat down and looked at my code for Copyshow and did
  8. a rewrite that works in 10 minutes.  It works just like DOS's copy,
  9. except it shows you progress in percentage.  Check this out...if you
  10. have any suggestions to tweak it, please tell me!}
  11.  
  12. Program CopyShow;
  13.  
  14. Uses Dos,Crt;
  15.  
  16. Var
  17.     Buf: Array[1..8092] of Byte;
  18.     FromF, ToF: File;
  19.     NumRead, NumWritten: Word;
  20.     Temp: PathStr;
  21.     PreDest: String;
  22.     Dir: DirStr;
  23.     Name: NameStr;
  24.     Ext: ExtStr;
  25.     DirInfo: SearchRec;
  26.     Total: LongInt;
  27.  
  28. Procedure Error(ErrorMsg: String);
  29. Begin
  30.   Writeln(ErrorMsg);
  31.   Halt(1);
  32. End;
  33.  
  34. Function ExistDir(DirName: String):Boolean;
  35. Var Dir: String;
  36.     Exist: Boolean;
  37. Begin
  38.   GetDir(0, Dir);
  39.   If DirName[Length(DirName)]='\' then Delete(DirName,Length(DirName),1);
  40.   {$I-} ChDir(DirName); {$I+}
  41.   Exist:=(IOResult=0) and (DirName<>'');
  42.   ChDir(Dir);
  43.   ExistDir:=Exist;
  44. End;
  45.  
  46. Var
  47.   OldX,OldY : Word;
  48. Begin
  49.   If ParamCount=0 then Error('Required parameter missing');
  50.   Temp:=ParamStr(1);
  51.   If ParamCount=1 then PreDest:='.\' Else PreDest:=ParamStr(2);
  52.   FSplit(PreDest, Dir, Name, Ext);
  53.   PreDest:=FExpand(Dir)+Name+Ext;
  54.   FSplit(Temp, Dir, Name, Ext);
  55.   Dir:=FExpand(Dir);
  56.   If PreDest=Dir then Error('File cannot be copied onto itself');
  57.   FindFirst(ParamStr(1), Archive, DirInfo);
  58.   If DosError<>0 then Error('File not found') Else While DosError=0 do Begin
  59.     If ExistDir(PreDest) then Temp:=PreDest+DirInfo.Name Else Temp:=PreDest;
  60.     Assign(FromF, Dir+DirInfo.Name);
  61.     Reset(FromF,1);
  62.     Assign(ToF, Temp);
  63.     Rewrite(ToF, 1);
  64.     Total:=0;
  65.     Write(DirInfo.Name:12,'        ');
  66.     OldX := WhereX; OldY := WhereY;
  67.     Repeat
  68.       GotoXY(OldX,OldY);
  69.       Write('==>',Total/DirInfo.Size*100:5:2,'%':10);
  70.       BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
  71.       BlockWrite(ToF, Buf, NumRead, NumWritten);
  72.       Inc(Total, NumWritten);
  73.     Until (NumRead=0) or (NumWritten<>NumRead);
  74.     GetFTime(FromF, Total);
  75.     SetFTime(ToF, Total);
  76.     Close(FromF);
  77.     Close(ToF);
  78.     Writeln;
  79.     FindNext(DirInfo);
  80.   End;
  81. End.